perm filename NSCTPY.F4[SYS,MUS]1 blob sn#010342 filedate 1975-08-20 generic text, type T, neo UTF8
	SUBROUTINE SEG(FUNC)
C  TYPE AMPL, STEP# (UP TO STEP 512). ---- SAME FORMAT AS GEN 1 IN MUSIC5.
	DIMENSION FUNC(512),A(4),MJ(6),MSG1(4)
	COMMON K,STEP,AMP1,AMP2,DIF,IT,IS,ST,STPS,RK
	DATA (A(K),K=1,3)/'SEG ARRAY FULL/'/
	DATA (MSG1(K),K=1,3)/'AMP., STEP:'/
	DATA (MJ(K),K=1,5)/'USE 100 STEPS FOR SEG!  /'/
	DO 34 I=1,512
34	FUNC(I)=0
	IF (QTTYIN(0)) CALL MESS(MJ)
C   REMOVE ABOVE LATER********
CC	CALL RDNUM(AMP1)
	AMP1=0
	ST=0
1	IF (QTTYIN(0))CALL MESS(MSG1)
	IF (QTTYIN(0))CALL SEE2(FUNC)
	CALL RDNUM(AMP2)
	CALL RDNUM(STEP)
	IF(STEP.GT.1.)GO TO 3
	AMP1=AMP2
	GO TO 1
C  STEP=1 AND STEP=0 ARE CONSIDERED THE SAME.
3	DIF=AMP2-AMP1
5	IT=ST
	IS=STEP*5.120+.0001
	STEP=IS
 	STPS=STEP-ST
	IS=STPS
	IF(IS+IT.GT.512)GO TO 6
	ST=STEP
	IF(ST.EQ.0)STEP=1.
	DO 2 K=1,IS
CC	M=K+IT
	RK=K
2	FUNC(K+IT)=AMP1+DIF*RK/STPS
	AMP1=AMP2
      	ST=STEP
CC	CALL PNUM(M)
	IF(STEP.LT.512)GO TO 1
CC	IF(STEP.GT.513.)GO TO 6
1102	CALL MESS(A)
	FUNC(1)=0.0
	IF (QTTYIN(0))CALL SEE(FUNC)
	RETURN
6	K=1
8	CALL RDNUM(RK)
7	FUNC(K)=RK
	K=K+1
	IF(K.LE.512)GO TO 8
	GO TO 1102
	END
	SUBROUTINE SYNTH (FUNC)
C   SCOPE WITH SYNTH IF FROM TTY!! AFTER 'SYNTH(F1);'  TYPE 99= TO USE  H,A,P,K:
C   ALL OTHER NUMBERS=H,A ONLY.  TYPE 999 TO END. NORMALIZATION IS AUTOMATIC.
	DIMENSION FUNC(512),F(5),FMSG(10),GMSG(9)
	COMMON I,XX,X,H,K,CON,XK,FAC,AMP,Y
	DATA (F(I),I=1,4)/'SYNTH ARRAY FULL   /'/
	DATA (FMSG(I),I=1,9)/'H,A,P,K (99 FOR SHORT FORM, 999 TO FINISH)'/
	DATA (GMSG(I),I=1,8)/'H,A (99 FOR LONG FORM, 999 TO FINISH)'/
	FAC=360./512.
	DO 15 I=1,512
15	FUNC(I)=0.0
	TTY=QTTYIN(0)
C SET TTY IF TELETYPE INPUT
	XX=-99
228	XX=-XX
226	IF (TTY.EQ.0) GO TO 229
	IF (XX) CALL MESS(FMSG)
	IF (-XX) CALL MESS(GMSG)
	CALL SEE2(FUNC)
229	CALL RDNUM(H)
	IF (H.EQ.99) GO TO 228
	IF (H.EQ.999)GO TO 2200
16	CALL RDNUM(AMP)
	IF(XX)GO TO 1016
	X=0
	CON=0
	GO TO 2016
1016	CALL RDNUM(X)
	X=X*512./360.+1.0
	CALL RDNUM(CON)
2016	DO 17 J=1,512
	XK=SIND(X*FAC)*AMP+CON
	IF(CON.LT.100.0)GO TO 1
	FUNC(J)=(XK-100.)*FUNC(J)
	GO TO 2
1	FUNC(J)=FUNC(J)+XK
2	X=X+H
	IF(X.LE.512.)GO TO 17
	X=X-512.
17	CONTINUE
	GO TO 226
2200	X=FUNC(1)
	DO 19 I=2,512
	H=ABS(FUNC(I))
19	IF(X.LT.H)X=H
	DO 20 I=1,512
20	FUNC(I)=FUNC(I)/X
	IF (TTY) CALL DPYCLR
	CALL MESS(F)
	RETURN
	END
C   ***********  DUR2 1969  *********
	FUNCTION DUR(P2,SPEED,CHNS)
	COMMON P,ISR,NC,IDUR,ID,IP(5)
	DATA IP/20000,25000,10000,50000,100000/
	P=P2
	ISPD=SPEED
	NC=CHNS*30+.3
3	IDUR=P*10000+.5
5	IDUR=(IDUR*IP(ISPD))/1000
6	ID=IDUR/NC
7	ID=IDUR-ID*NC
	IF(ID.EQ.0)GO TO 1
	P=P+.0001
	GO TO 3
1	DUR=P
	RETURN
	END